home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_colc.pl < prev    next >
Encoding:
Perl Script  |  1994-05-18  |  9.0 KB  |  287 lines

  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_colc.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_colc" perl package.  It defines
  8. ##    routines to handle the ColorCatalog via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_colc;
  31.  
  32. ##----------------------------------------------##
  33. ## Add ColorCatalog function to %MIFToken array ##
  34. ##----------------------------------------------##
  35. $mif'MIFToken{'ColorCatalog'} = 'ColorCatalog';
  36.  
  37. ##---------------------------------##
  38. ## ColorCatalog associative arrays ##
  39. ##---------------------------------##
  40. %ColorCyan    = ();    # Percentage of cyan
  41. %ColorMagenta    = ();    # Percentage of magenta
  42. %ColorYellow    = ();    # Percentage of yellow
  43. %ColorBlack    = ();    # Percentage of black
  44. %ColorPantone    = ();    # Name of PANTONE color
  45. %ColorAttribute = ();    # $; separated string of attributes
  46.  
  47. ##----------------------------------------##
  48. ## Variables for current Color definition ##
  49. ##----------------------------------------##
  50. $col_Attribute    = "";
  51. $col_Black    = "";
  52. $col_Cyan    = "";
  53. $col_Magenta    = "";
  54. $col_Pantone    = "";
  55. $col_Tag    = "";
  56. $col_Yellow    = "";
  57.  
  58. ##------------------------##
  59. ## Import 'mif' variables ##
  60. ##------------------------##
  61. $MStore        = $mif'MStore;
  62. $MOpen        = $mif'MOpen;
  63. $MClose        = $mif'MClose;
  64. $MLine        = $mif'MLine;
  65. $mso        = $mif'mso;
  66. $msc        = $mif'msc;
  67. $stb        = $mif'stb;
  68. $ste        = $mif'ste;
  69. $como        = $mif'como;
  70.  
  71.                 ##---------------##
  72.                 ## Main Routines ##
  73.                 ##---------------##
  74. ##---------------------------------------------------------------------------
  75. ##    MIFwrite_colc() outputs the ColorCatalog as defined by the
  76. ##    associative arrays.
  77. ##
  78. ##    Usage:
  79. ##        &'MIFwrite_colc(FILEHANDLE);
  80. ##
  81. sub main'MIFwrite_colc {
  82.     local($handle, $l) = @_;
  83.     local($i0, $i1, $i2) = (' ' x $l, ' ' x (1+$l), ' ' x (2+$l));
  84.  
  85.     print $handle $i0, $mso, 'ColorCatalog', "\n";
  86.     foreach (sort keys %ColorCyan) {
  87.     print $handle $i1, $mso, "Color\n";
  88.     print $handle $i2, $mso, 'ColorTag ', $stb, $_, $ste, $msc, "\n";
  89.     print $handle $i2, $mso, 'ColorCyan ', $ColorCyan{$_}, $msc, "\n";
  90.     print $handle $i2, $mso, 'ColorMagenta ', $ColorMagenta{$_}, $msc, "\n";
  91.     print $handle $i2, $mso, 'ColorYellow ', $ColorYellow{$_}, $msc, "\n";
  92.     print $handle $i2, $mso, 'ColorBlack ', $ColorBlack{$_}, $msc, "\n";
  93.     print $handle $i2, $mso, 'ColorPantoneValue ', $stb,
  94.                $ColorPantone{$_}, $ste, $msc, "\n"
  95.         if $ColorPantone{$_};
  96.     if ($ColorAttribute{$_}) {
  97.         foreach (split(/$;/, $ColorAttribute{$_})) {
  98.         print $handle $i2, $mso, 'ColorAttribute ', $_, $msc, "\n";
  99.         }
  100.     }
  101.     print $handle $i1, $msc, " $como end of Color\n";
  102.     }
  103.     print $handle $i0, $msc, " $como end of ColorCatalog\n";
  104. }
  105. ##---------------------------------------------------------------------------##
  106. ##    MIFget_color_data() returns the data associated with the Frame
  107. ##    color $color.
  108. ##
  109. ##    Usage:
  110. ##        ($cyan, $magenta, $yellow, $black, $pantone, $attr) =
  111. ##            &'MIFget_color_data($color);
  112. ##
  113. ##    Note: $attr is a $; separated string of attributes.
  114. ##
  115. sub main'MIFget_color_data {
  116.     local($color) = @_;
  117.     ($ColorCyan{$color}, 
  118.      $ColorMagenta{$color}, 
  119.      $ColorYellow{$color}, 
  120.      $ColorBlack{$color}, 
  121.      $ColorPantone{$color}, 
  122.      $ColorAttribute{$color});
  123. }
  124. ##---------------------------------------------------------------------------##
  125. ##    Usage:
  126. ##        &'MIFset_color_data($color, $C, $M, $Y, $K, $pantone, $attr);
  127. ##
  128. sub main'MIFset_color_data {
  129.     local($color) = shift @_;
  130.     ($ColorCyan{$color}, 
  131.      $ColorMagenta{$color}, 
  132.      $ColorYellow{$color}, 
  133.      $ColorBlack{$color}, 
  134.      $ColorPantone{$color}, 
  135.      $ColorAttribute{$color}) = @_;
  136. }
  137. ##---------------------------------------------------------------------------##
  138. ##    MIFget_colors() returns a sorted array of all color names defined
  139. ##    in the color catalog.
  140. ##
  141. ##    Usage:
  142. ##        @colors = &'MIFget_colors();
  143. ##
  144. sub main'MIFget_colors {
  145.     return sort keys %ColorCyan;
  146. }
  147. ##---------------------------------------------------------------------------##
  148. ##    MIFreset_colc() resets the associative arrays for the color
  149. ##    catalog.
  150. ##
  151. ##    Usage:
  152. ##        &'MIFreset_colc();
  153. ##
  154. sub main'MIFreset_colc {
  155.     undef %ColorCyan;
  156.     undef %ColorMagenta;
  157.     undef %ColorYellow;
  158.     undef %ColorBlack;
  159.     undef %ColorPantone;
  160.     undef %ColorAttribute;
  161. }
  162. ##---------------------------------------------------------------------------##
  163.                 ##--------------##
  164.                 ## Mif Routines ##
  165.                 ##--------------##
  166. ##---------------------------------------------------------------------------##
  167. ##    The routines definded below are all registered in the %MIFToken         ##
  168. ##    array for use in the read_mif() routine.  There purpose is to         ##
  169. ##    store the information contained in the color catalog.             ##
  170. ##---------------------------------------------------------------------------##
  171.  
  172. ##---------------------------------------------------------------------------
  173. ##    ColorCatalog() is the token routine for 'ColorCatalog'.
  174. ##    It sets/restores token routines depending upon mode.
  175. ##
  176. sub mif'ColorCatalog {
  177.     local($token, $mode, *data) = @_;
  178.     if ($mode == $MOpen) {
  179.     ($_fast, $_noidata) = ($mif'fast, $mif'no_import_data);
  180.     ($mif'fast, $mif'no_import_data) = (1, 1);
  181.     @_col_orgfunc = @mif'MIFToken{
  182.                 'Color',
  183.                 'ColorTag',
  184.                 'ColorCyan',
  185.                 'ColorMagenta',
  186.                 'ColorYellow',
  187.                 'ColorBlack',
  188.                 'ColorPantoneValue',
  189.                 'ColorAttribute'
  190.             };
  191.     @mif'MIFToken{
  192.         'Color',
  193.         'ColorTag',
  194.         'ColorCyan',
  195.         'ColorMagenta',
  196.         'ColorYellow',
  197.         'ColorBlack',
  198.         'ColorPantoneValue',
  199.         'ColorAttribute'
  200.     } = (
  201.         "mif_colc'Color",
  202.         "mif_colc'ColorTag",
  203.         "mif_colc'ColorCyan",
  204.         "mif_colc'ColorMagenta",
  205.         "mif_colc'ColorYellow",
  206.         "mif_colc'ColorBlack",
  207.         "mif_colc'ColorPantoneValue",
  208.         "mif_colc'ColorAttribute"
  209.     );
  210.     } elsif ($mode == $MClose) {
  211.     @mif'MIFToken{
  212.         'Color',
  213.         'ColorTag',
  214.         'ColorCyan',
  215.         'ColorMagenta',
  216.         'ColorYellow',
  217.         'ColorBlack',
  218.         'ColorPantoneValue',
  219.         'ColorAttribute'
  220.     } = @_col_orgfunc;
  221.     ($mif'fast, $mif'no_import_data) = ($_fast, $_noidata);
  222.     }
  223. }
  224. ##---------------------------------------------------------------------------
  225. sub Color {
  226.     local($token, $mode, *data) = @_;
  227.  
  228.     if ($mode == $MOpen) {
  229.     $col_Attribute = "";
  230.     $col_Black = "";
  231.     $col_Cyan = "";
  232.     $col_Magenta = "";
  233.     $col_Pantone = "";
  234.     $col_Tag = "";
  235.     $col_Yellow = "";
  236.     } elsif ($mode == $MClose) {
  237.     $ColorCyan{$col_Tag} = $col_Cyan;
  238.     $ColorMagenta{$col_Tag} = $col_Magenta;
  239.     $ColorYellow{$col_Tag} = $col_Yellow;
  240.     $ColorBlack{$col_Tag} = $col_Black;
  241.     $ColorPantone{$col_Tag} = $col_Pantone;
  242.     $ColorAttribute{$col_Tag} = $col_Attribute;
  243.     } else {
  244.     warn "Unexpected mode, $mode, passed to Color routine\n";
  245.     }
  246. }
  247. ##---------------------------------------------------------------------------
  248. sub ColorTag {
  249.     local($token, $mode, *data) = @_;
  250.     ($col_Tag) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  251. }
  252. ##---------------------------------------------------------------------------
  253. sub ColorPantoneValue {
  254.     local($token, $mode, *data) = @_;
  255.     ($col_Pantone) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  256. }
  257. ##---------------------------------------------------------------------------
  258. sub ColorCyan {
  259.     local($token, $mode, *data) = @_;
  260.     ($col_Cyan) = $data =~ /^\s*(.*)$/o;
  261. }
  262. ##---------------------------------------------------------------------------
  263. sub ColorMagenta {
  264.     local($token, $mode, *data) = @_;
  265.     ($col_Magenta) = $data =~ /^\s*(.*)$/o;
  266. }
  267. ##---------------------------------------------------------------------------
  268. sub ColorYellow {
  269.     local($token, $mode, *data) = @_;
  270.     ($col_Yellow) = $data =~ /^\s*(.*)$/o;
  271. }
  272. ##---------------------------------------------------------------------------
  273. sub ColorBlack {
  274.     local($token, $mode, *data) = @_;
  275.     ($col_Black) = $data =~ /^\s*(.*)$/o;
  276. }
  277. ##---------------------------------------------------------------------------
  278. sub ColorAttribute {
  279.     local($token, $mode, *data) = @_;
  280.     local($tmp);
  281.     $col_Attribute .= $; if $col_Attribute ne "";
  282.     ($tmp) = $data =~ /^\s*(.*)$/o;
  283.     $col_Attribute .= $tmp;
  284. }
  285. ##---------------------------------------------------------------------------
  286. 1;
  287.